Assignment1
Ran Wang
9/22/2021
Introduction
Transit Oriented Development has become an important topic for urban planning. As Chicago, a city with a long history of transit, proposed new plans for Chicago “L” the rapid transit system, we argue it is important to first understand the relationship between transit and development. Are people willing to pay more to live near the transit in Chicago? This project explores what the differences between TOD and Non-TOD neigborhoods are and how significant these differences are to lead dicision-makers to conclude that TOD will thrive in Chicago.
Getting 2000 Data
Because we are focusing on the influence of TOD on neighborhoods, we only use census tracts within the Chicago city boundary because other suburban tracts in Cook County might skew our analysis.
CTA_boundary <-st_read("https://data.cityofchicago.org/api/geospatial/5jrd-6zik?method=export&format=KML") %>%
st_transform('EPSG:26916')## Reading layer `Layer #0' from data source
## `https://data.cityofchicago.org/api/geospatial/5jrd-6zik?method=export&format=KML'
## using driver `KML'
## Simple feature collection with 801 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -87.94025 ymin: 41.64429 xmax: -87.52366 ymax: 42.02392
## Geodetic CRS: WGS 84CTA_boundary_buffer <- st_union(CTA_boundary)
vars00 <- c("P001001","P006002","PCT025050","PCT025009","P053001","H056001","P092001")
tracts00 <-
get_decennial(geography = "tract", vars00,
year=2000, state='IL', county='Cook', geometry=T) %>%
st_transform('EPSG:26916')## Getting data from the 2000 decennial Census## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Variables not found in Summary File 1. Trying Summary File 3...##
|
| | 0%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 16%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 22%
|
|================== | 25%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|============================ | 40%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 52%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|============================================ | 62%
|
|============================================= | 64%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 72%
|
|=================================================== | 74%
|
|===================================================== | 75%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 99%
|
|======================================================================| 100%tracts00<- tracts00%>%spread(variable, value)%>%
rename (
TotalPop = P001001,
Whites = P006002,
FemaleBachelors = PCT025050,
MaleBachelors = PCT025009,
MedHHInc = P053001,
MedRent = H056001,
TotalPoverty = P092001)%>%
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop, 0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop), 0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2000") %>%
dplyr::select(-Whites,-FemaleBachelors,-MaleBachelors,-TotalPoverty,-NAME)
tracts00 <- st_intersection(tracts00,CTA_boundary_buffer)## Warning: attribute variables are assumed to be spatially constant throughout all
## geometriesGetting 2017 Data
vars17 <- c("B25026_001E","B02001_002E","B15001_050E",
"B15001_009E","B19013_001E","B25058_001E",
"B06012_002E")
tracts17 <-
get_acs(geography = "tract", vars17,
year=2017, state='IL', county='Cook', geometry=T) %>%
st_transform('EPSG:26916')## Getting data from the 2013-2017 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.##
|
| | 0%
|
|= | 1%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|========= | 12%
|
|========= | 13%
|
|========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============== | 21%
|
|================ | 23%
|
|================= | 24%
|
|================== | 26%
|
|==================== | 28%
|
|===================== | 29%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 35%
|
|========================= | 36%
|
|========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 42%
|
|============================== | 43%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 48%
|
|================================== | 49%
|
|==================================== | 51%
|
|===================================== | 52%
|
|===================================== | 53%
|
|======================================= | 56%
|
|======================================== | 58%
|
|========================================== | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 68%
|
|================================================ | 69%
|
|==================================================== | 75%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================== | 80%
|
|========================================================== | 83%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 98%
|
|======================================================================| 100%clip17 <-
st_intersection(tracts17,CTA_boundary_buffer) %>%
dplyr::select(GEOID,variable,estimate) ## Warning: attribute variables are assumed to be spatially constant throughout all
## geometriestracts17<-
clip17 %>%
spread(variable, estimate)%>%
rename(TotalPop = B25026_001,
Whites = B02001_002,
FemaleBachelors = B15001_050,
MaleBachelors = B15001_009,
MedHHInc = B19013_001,
MedRent = B25058_001,
TotalPoverty = B06012_002)%>%
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop,0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop),0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2017") %>%
dplyr::select(-Whites, -FemaleBachelors, -MaleBachelors, -TotalPoverty)Binding 2000 and 2017 Data
allTracts <- rbind(tracts00,tracts17)Getting Transit Data
CTA_stops <- st_read("https://data.cityofchicago.org/download/4qtv-9w43/application%2Fxml") %>%
select(-Description)%>%
st_transform('EPSG:26916')## Reading layer `CTA_RailStations' from data source
## `https://data.cityofchicago.org/download/4qtv-9w43/application%2Fxml'
## using driver `KML'
## Simple feature collection with 144 features and 2 fields
## Geometry type: POINT
## Dimension: XYZ
## Bounding box: xmin: -87.90185 ymin: 41.72238 xmax: -87.60586 ymax: 42.07315
## z_range: zmin: 0 zmax: 0
## Geodetic CRS: WGS 84CTA_stops<- CTA_stops[CTA_boundary_buffer,]
plot(CTA_stops)
CTA_buffer <- rbind(
st_buffer(CTA_stops, 800) %>%
mutate(Legend = "Buffer") %>%
dplyr::select(Legend),
st_union(st_buffer(CTA_stops, 800)) %>%
st_sf() %>%
mutate(Legend = "Unioned Buffer"))
buffer <- filter(CTA_buffer, Legend=="Unioned Buffer")The below map shows the Chicago “L” stations and the buffer area within 1/2 mile of stations.
ggplot() +
geom_sf(data=tracts00)+
geom_sf(data=CTA_buffer) +
geom_sf(data=CTA_stops, show.legend = "point") +
facet_wrap(~Legend) +
labs(caption = "CTAstops Buffer Zones") +
mapTheme()
TOD Indicator
selectCentroids <-
st_centroid(tracts00)[buffer,] %>%
st_drop_geometry() %>%
left_join(dplyr::select(tracts00, GEOID)) %>%
st_sf() %>%
dplyr::select(TotalPop) %>%
mutate(Selection_Type = "Select by Centroids")## Warning in st_centroid.sf(tracts00): st_centroid assumes attributes are constant
## over geometries of x## Joining, by = "GEOID"allTracts.group <-
rbind(
st_centroid(allTracts)[buffer,] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "TOD"),
st_centroid(allTracts)[buffer, op = st_disjoint] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "Non-TOD")) %>%
mutate(MedRent.inf = ifelse(year == "2000", MedRent * 1.42, MedRent)) ## Warning in st_centroid.sf(allTracts): st_centroid assumes attributes are
## constant over geometries of x## Joining, by = c("GEOID", "MedRent", "TotalPop", "MedHHInc", "pctWhite", "pctBachelors", "pctPoverty", "year")## Warning in st_centroid.sf(allTracts): st_centroid assumes attributes are
## constant over geometries of x## Joining, by = c("GEOID", "MedRent", "TotalPop", "MedHHInc", "pctWhite", "pctBachelors", "pctPoverty", "year")TOD Indicator Maps
The Time/Space Groups map shows the changes of TOD census tracts between 2000 and 2017. In the Chicago case, TOD census tracts stay largely the same.
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts17))+
geom_sf(aes(fill = TOD)) +
labs(title = "Time/Space Groups") +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(size=22))
The Median Rent map shows the changes of median rent in census tracts between 2000 and 2017. TOD census tracts within the red border generally experienced a rise in median rent.
ggplot() +
geom_sf(data = st_union(tracts17)) +
geom_sf(data = allTracts.group, aes(fill=q5(MedRent.inf)))+
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "MedRent.inf"),
name = "Median Rent\n(Quintile Breaks)") +
facet_wrap(~year)+
geom_sf(data = buffer, colour = "red", fill = "transparent")+
labs(title = "Chicago 2000-2017 Mediant Rent", subtitle = "Real Dollars. The red border indicates areas within 1/2 mile to transit stations. ") +
mapTheme() + theme(plot.title = element_text(size=22))
The Percentage of White map shows the changes of the percentage of white population between 2000 and 2017. TOD census tracts in the North city had significant increase in the percentage of white population, and tracts in the South shared the same trend but in a smaller scale.
ggplot() +
geom_sf(data = st_union(tracts17)) +
geom_sf(data = allTracts.group, aes(fill=q5(pctWhite)))+
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctWhite",rnd=FALSE),
name = "Percentage of White\n(Quintile Breaks)") +
facet_wrap(~year)+
geom_sf(data = buffer, colour = "red", fill = "transparent")+
labs(title = "Chicago 2000-2017 Percentage of WHite", subtitle = "The red border indicates areas within 1/2 mile to transit stations. ") +
mapTheme() + theme(plot.title = element_text(size=22))
The Percentage of People w/ Bachelor Degree map shows the changes of the population with Bachelor Degrees between 2000 and 2017. The change in TOD census tracts are not significantly visible from the map.
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts00))+
geom_sf(data = st_union(tracts17))+
geom_sf(aes(fill = q5(pctBachelors))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctBachelors", rnd=FALSE),
name = "Percent of Bachelors\n(Quintile Breaks)") +
facet_wrap(~year)+
geom_sf(data = buffer, fill = "transparent", color = "red")+
labs(title = "Percent of people wi/ Bachelor Degree 2000-2017", subtitle = "The red border indicates areas within 1/2 mile to transit stations. ") +
mapTheme() + theme(plot.title = element_text(size=22))
The Percentage of Poverty map shows the change of the percentage of people below the poverty line between 2000 and 2017. There is a notable decline of population in poverty in the North city as a general trend regardless of TOD status, while changes in the South city is more fuzzy.
ggplot(allTracts.group)+
geom_sf(data = st_union(tracts00))+
geom_sf(data = st_union(tracts17))+
geom_sf(aes(fill = q5(pctPoverty))) +
scale_fill_manual(values = palette5,
labels = qBr(allTracts.group, "pctPoverty", rnd=FALSE),
name = "Percent of Poverty\n(Quintile Breaks)") +
facet_wrap(~year)+
geom_sf(data = buffer, fill = "transparent", color = "red")+
labs(title = "Percent of Poverty 2000-2017", subtitle = "The red border indicates areas within 1/2 mile to transit stations. ") +
mapTheme() + theme(plot.title = element_text(size=22))
TOD Indicator Table
The table below demonstrates the average of TOD indicators for TOD and Non-TOD tracts in 2000 and 2017. The most notable change is the increase of median rent as the rent gap between TOD and Non-TOD widened significantly, a change that is more straightforward in the plot. The gap of percentage of white between TOD and Non-TOD tracts also widened. While both TOD and Non-TOD tracts lost population, Non-TOD tracts lost more residents on average.
allTracts.Summary <-
st_drop_geometry(allTracts.group) %>%
group_by(year, TOD) %>%
summarize(Rent = mean(MedRent, na.rm = T),
Population = mean(TotalPop, na.rm = T),
Percent_White = mean(pctWhite, na.rm = T),
Percent_Bach = mean(pctBachelors, na.rm = T),
Percent_Poverty = mean(pctPoverty, na.rm = T))## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.allTracts.Summary %>%
unite(year.TOD, year, TOD, sep = ": ", remove = T) %>%
gather(Variable, Value, -year.TOD) %>%
mutate(Value = round(Value, 2)) %>%
spread(year.TOD, Value) %>%
kable() %>%
kable_styling() %>%
footnote(general_title = "TOD Inditators, Chicago",
general = "\n")| Variable | 2000: Non-TOD | 2000: TOD | 2017: Non-TOD | 2017: TOD |
|---|---|---|---|---|
| Percent_Bach | 0.01 | 0.02 | 0.01 | 0.03 |
| Percent_Poverty | 0.35 | 0.40 | 0.21 | 0.23 |
| Percent_White | 0.41 | 0.39 | 0.47 | 0.53 |
| Population | 3923.42 | 2739.92 | 3686.20 | 3035.84 |
| Rent | 528.41 | 553.42 | 873.72 | 1022.61 |
| TOD Inditators, Chicago | ||||
|
|
allTracts.Summary %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot(aes(year, Value, fill = TOD)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~Variable, scales = "free", ncol=5) +
scale_fill_manual(values = c("#bae4bc", "#0868ac")) +
labs(title = "Indicator differences across time and space") +
plotTheme() + theme(legend.position="bottom")
Graduted Symbol Maps
The graduated symbol map of population below shows the change of population in census tracts within 1/2 mile of transit stations between 2000 and 2017. The TOD tracts in the center city area experienced population growth, while TOD tracts in the North city experienced some decline in population and the TOD tracts in the South city generally remained stable.
new_CTAstops <- CTA_stops
new_CTAstops <- st_join(CTA_stops, allTracts.group, join = st_intersects) %>%
na.omit()
ggplot()+
geom_sf(data = allTracts,
fill = "antiquewhite1", color = "grey75")+
geom_sf(data = new_CTAstops %>%
st_centroid(),
shape = 21,
aes(
size = TotalPop,
fill = TotalPop
),alpha = 1, show.legend = "point") +
scale_size_continuous(
range = c(1,6),
breaks = c(0, 1644, 2934, 5172, 18841),
labels = qBr(new_CTAstops, "TotalPop"),
name = "Total Population")+
scale_fill_stepsn(
colors = palette5,
breaks = c(0, 1644, 2934, 5172, 18841),
guide = FALSE)+
labs(title = "Graduated Symbol Map of Population", subtitle = "within 1/2 mi of stations\n 2000-2017") +
facet_wrap(~year)+
mapTheme()+
guides(size = guide_legend(override.aes = list(fill = palette5)))## Warning in st_centroid.sf(.): st_centroid assumes attributes are constant over
## geometries of x## Warning: It is deprecated to specify `guide = FALSE` to remove a guide. Please
## use `guide = "none"` instead.
The graduated symbol map of median rent shows the change of median rent in census tracts within 1/2 mile of transit stations between 2000 and 2017. All TOD tracts experienced an increase in of median rent.
ggplot()+
geom_sf(data = allTracts,
fill = "antiquewhite1", color = "grey75")+
geom_sf(data = new_CTAstops %>%
st_centroid(),
shape = 21,
aes(
size = MedRent,
fill = MedRent
),alpha = 1, show.legend = "point") +
scale_size_continuous(
range = c(1,6),
breaks = c(0, 680, 864, 1406, 2261),
labels = qBr(new_CTAstops, "MedRent"),
name = "Median Rent")+
scale_fill_stepsn(
colors = palette5,
breaks = c(0, 680, 864, 1406, 2261),
guide = FALSE)+
labs(title = "Graduated Symbol Map of Median Rent", subtitle = "within 1/2 mi of stations\n 2000-2017") +
facet_wrap(~year)+
mapTheme()+
guides(size = guide_legend(override.aes = list(fill = palette5)))## Warning in st_centroid.sf(.): st_centroid assumes attributes are constant over
## geometries of x## Warning: It is deprecated to specify `guide = FALSE` to remove a guide. Please
## use `guide = "none"` instead.
Multiple Ring Buffer
The line plot below demonstrates the median rent as a function of distance to transit stations. In 2017, rent decreased as houses were further away from transit stations, supporting that TOD would increase rent. The rent then increase when the distance is larger than 4 miles might due to suburbs that are remote from transit yet have high property value.
multipleRingBuffer <- function(inputPolygon, maxDistance, interval)
{
#create a list of distances that we'll iterate through to create each ring
distances <- seq(0, maxDistance, interval)
#we'll start with the second value in that list - the first is '0'
distancesCounter <- 2
#total number of rings we're going to create
numberOfRings <- floor(maxDistance / interval)
#a counter of number of rings
numberOfRingsCounter <- 1
#initialize an otuput data frame (that is not an sf)
allRings <- data.frame()
#while number of rings counteris less than the specified nubmer of rings
while (numberOfRingsCounter <= numberOfRings)
{
#if we're interested in a negative buffer and this is the first buffer
#(ie. not distance = '0' in the distances list)
if(distances[distancesCounter] < 0 & distancesCounter == 2)
{
#buffer the input by the first distance
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#different that buffer from the input polygon to get the first ring
buffer1_ <- st_difference(inputPolygon, buffer1)
#cast this sf as a polygon geometry type
thisRing <- st_cast(buffer1_, "POLYGON")
#take the last column which is 'geometry'
thisRing <- as.data.frame(thisRing[,ncol(thisRing)])
#add a new field, 'distance' so we know how far the distance is for a give ring
thisRing$distance <- distances[distancesCounter]
}
#otherwise, if this is the second or more ring (and a negative buffer)
else if(distances[distancesCounter] < 0 & distancesCounter > 2)
{
#buffer by a specific distance
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#create the next smallest buffer
buffer2 <- st_buffer(inputPolygon, distances[distancesCounter-1])
#This can then be used to difference out a buffer running from 660 to 1320
#This works because differencing 1320ft by 660ft = a buffer between 660 & 1320.
#bc the area after 660ft in buffer2 = NA.
thisRing <- st_difference(buffer2,buffer1)
#cast as apolygon
thisRing <- st_cast(thisRing, "POLYGON")
#get the last field
thisRing <- as.data.frame(thisRing$geometry)
#create the distance field
thisRing$distance <- distances[distancesCounter]
}
#Otherwise, if its a positive buffer
else
{
#Create a positive buffer
buffer1 <- st_buffer(inputPolygon, distances[distancesCounter])
#create a positive buffer that is one distance smaller. So if its the first buffer
#distance, buffer1_ will = 0.
buffer1_ <- st_buffer(inputPolygon, distances[distancesCounter-1])
#difference the two buffers
thisRing <- st_difference(buffer1,buffer1_)
#cast as a polygon
thisRing <- st_cast(thisRing, "POLYGON")
#geometry column as a data frame
thisRing <- as.data.frame(thisRing[,ncol(thisRing)])
#add teh distance
thisRing$distance <- distances[distancesCounter]
}
#rbind this ring to the rest of the rings
allRings <- rbind(allRings, thisRing)
#iterate the distance counter
distancesCounter <- distancesCounter + 1
#iterate the number of rings counter
numberOfRingsCounter <- numberOfRingsCounter + 1
}
#convert the allRings data frame to an sf data frame
allRings <- st_as_sf(allRings)
}
allTracts.rings <-
st_join(st_centroid(dplyr::select(allTracts, GEOID, year)),
multipleRingBuffer(buffer, 15000, 800)) %>%
st_drop_geometry() %>%
left_join(dplyr::select(allTracts, GEOID, MedRent, year),
by=c("GEOID"="GEOID", "year"="year")) %>%
st_sf() %>%
na.omit()%>%
mutate(distance = distance /1609.34)## Warning in st_centroid.sf(dplyr::select(allTracts, GEOID, year)): st_centroid
## assumes attributes are constant over geometries of x## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries## Warning in st_cast.sf(thisRing, "POLYGON"): repeating attributes for all sub-
## geometries for which they may not be constant## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries## Warning in st_cast.sf(thisRing, "POLYGON"): repeating attributes for all sub-
## geometries for which they may not be constant## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometriesSummary_allTracts.rings <-
st_drop_geometry(allTracts.rings) %>%
group_by(year, distance) %>%
summarize(Rent = mean(MedRent, na.rm = T))## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.ggplot(data=Summary_allTracts.rings,aes(x=distance,y=Rent,color=year))+
geom_line(size=2)+
labs(title = "Rent as a function of distance to subway stations",subtitle = "Census tracts")+
xlab("Miles")+
ylab("Average rent")
Crime Data
Because we are unable to get 2000 crime data, we use 2009 crime data instead for 2009 is the earliest year with crime data that we can access.
crime_2009 <- get_crime_data(
years = 2009,
cities = c("Chicago"),
type = "core"
) %>%
filter(offense_type == "destruction/damage/vandalism of property (except arson)")## Downloading list of URLs for data files. This takes a few seconds but is only done once per session.## Downloading core data for Chicago in 2009##
|
| | 0%
|
|======================================================================| 100%
##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|======================================================================| 99%
|
|======================================================================| 100%crime_2017 <- get_crime_data(
years = 2017,
cities = c("Chicago"),
type = "core"
) %>%
filter(offense_type == "destruction/damage/vandalism of property (except arson)")## Using cached URLs to get data from server. These URLs rarely change and this is almost certainly safe.## Downloading core data for Chicago in 2017##
|
| | 0%
|
|======================================================================| 100%
##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================= | 92%
|
|================================================================== | 94%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%crime0917 <- rbind(crime_2009,crime_2017)%>%
st_as_sf(coords = c("longitude","latitude"), crs=st_crs(4326),agr="constant") %>%
st_transform(st_crs(allTracts.group))
tracts_crime <- st_join(allTracts.group, crime0917, join = st_intersects)
crime_count <- count(as_tibble(tracts_crime), GEOID)
tracts_crimecount <- left_join(crime_count, tracts_crime) %>%
rename("Crimecount" = n) %>%
st_as_sf()## Joining, by = "GEOID"tracts_crimecount <- tracts_crimecount %>%
dplyr::select(-offense_type, -offense_group, -offense_against, -date_single,
-location_type, -location_category)Crime Map
The Crime Count map shows counts of property crimes for census tracts. We focus on property crimes because an important component and results of TOD is property development. TOD tracts have slightly less property crimes compared with Non-TOD tracts nearby.
ggplot(tracts_crimecount[CTA_boundary,])+
geom_sf(data = tracts17, fill = "antiquewhite1", color = "grey75")+
geom_sf(aes(fill = q5(Crimecount))) +
geom_sf(data = buffer, fill = "transparent", color = "red") +
scale_fill_manual(values = palette5,
labels = qBr(tracts_crimecount, "Crimecount"),
name = "Crime count\n(Quintile Breaks)") +
labs(title = "Crime count 2009-2017", subtitle = "The red border denotes areas close to rail stations") +
facet_wrap(~year)+
mapTheme() +
theme(plot.title = element_text(size=22))
Crime and TOD Indicators
The table and the plot below show the average property crime cases and TOD indicators. Interestingly, while TOD tracts continue to have less crime cases, the average number of crime cases for TOD tracts increased while the one for Non-TOD tracts decreased. The gap between TOD and Non-TOD tracts narrowed.
tracts_crime.summary <-
st_drop_geometry(tracts_crimecount) %>%
group_by(year, TOD) %>%
summarize(Rent = mean(MedRent, na.rm = T),
Population = mean(TotalPop, na.rm = T),
Percent_White = mean(pctWhite, na.rm = T),
Percent_Bach = mean(pctBachelors, na.rm = T),
Percent_Poverty = mean(pctPoverty, na.rm = T),
Crime = mean(Crimecount, na.rm = T))## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.tracts_crime.summary %>%
unite(year.TOD, year, TOD, sep = ": ", remove = T)%>%
gather(Variable, Value, -year.TOD) %>%
mutate(Value = round(Value, 2)) %>%
spread(year.TOD, Value)%>%
kable() %>%
kable_styling() %>%
footnote(general_title = "TOD Inditators and Crime, Chicago",
general = "\n")| Variable | 2000: Non-TOD | 2000: TOD | 2017: Non-TOD | 2017: TOD |
|---|---|---|---|---|
| Crime | 248.70 | 200.13 | 230.32 | 204.64 |
| Percent_Bach | 0.01 | 0.02 | 0.01 | 0.02 |
| Percent_Poverty | 0.33 | 0.40 | 0.25 | 0.27 |
| Percent_White | 0.30 | 0.36 | 0.33 | 0.43 |
| Population | 5338.41 | 3758.92 | 4009.79 | 3498.50 |
| Rent | 511.13 | 557.37 | 816.75 | 985.79 |
| TOD Inditators and Crime, Chicago | ||||
|
|
tracts_crime.summary %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot(aes(year, Value, fill = TOD)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~Variable, scales = "free", ncol=5) +
scale_fill_manual(values = c("#bae4bc", "#0868ac")) +
labs(title = "Indicator differences across time and space") +
plotTheme() + theme(legend.position="bottom")
Conclusion
In general, TOD tracts are associated with the growth in rent, the increase of white population and highly-educated population, more decrease in poverty, less loss of general population, and more safety. People in Chicago are likely to pay more to live close to transit.
However, the analysis above also shows that Chicago is divided up into the North and the South, two parts of the city that share trends on different scales or even different trends in specific TOD indicators such as poverty and crime. Thus, TOD in Chicago requires more contextualized analysis and decision-making. While TOD is likely to succeed in Chicago, the city should consider carefully which part of the city is more suitable for TOD.